#!/usr/bin/env tclsh
# $Id: test7.tcl 9ce65bed8ef4 2012/08/26 02:14:51 pgurumur $
# Copyright (c) 2012 Prabhu Gurumurthy <pgurumur@gmail.com>
#
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
#

# __version__  = "$Revision: 9ce65bed8ef4 $"
# __author__   = "$Author: pgurumur $"
# __modified__ = "$Date: 2012-08-26 02:14:51Z $"

set version 0

proc checkip address {
   global version
   set retval ""
   set temp [split $address ':']
   set last [lindex $temp [expr [llength $temp] - 1]]
   set value [string first . $last]

   if {$value > 0} {
      set version 4
   } else {
      set version 6
   }

   if {$version == 4} {
      set count 0
      set temp [list]
      foreach octet [split $last "."] {
         incr count
         if {$count <= 4 && $count > 0} {
            if {$octet < 0 || $octet > 255} {
               puts "Invalid $count octet: $octet"
               exit 1
            } else {
               lappend temp $octet
            }
         } else {
            puts "Invalid ip address $address"
            exit 1
         }
      }

      if {$count < 4} {
         set maxval 4
         for {set ix [llength $temp]} { $ix < $maxval} {incr ix} {
            lappend temp 0
         }

         set retval [join $temp "."]
      } elseif {$count == 4} {
         set retval $address
      }
   } elseif {$version == 6} {
      foreach nibble $temp {
         set strlen [string length $nibble]
         if {$strlen && [catch {expr int(0x$nibble)} err]} {
            puts "$err"
            exit 1
         }
      }

      set retval [join $temp ":"]
   }
}

proc address subnet {
   global version
   set var [split $subnet '/']
   set ip [lindex $var 0]
   set netlen [lindex $var 1]
   checkip $ip
}

address $argv
